Преобразование Бэклунда и формула суперпозиции для синус-Гордона

Проверка подстановок приводящих уравнения, преобразование Бэклунда и формулу суперпозиции к рациональному виду. Формула суперпозиции записывается в виде F((Subscript[q, m,n]),(Subscript[q, m+1,n]),(Subscript[q, m,n+1]),(Subscript[q, m+1,n+1]))=0, где F – многочлен, линейный по каждой переменной, поэтому это уравнение легко разрешается относительно любой из них.

(Subscript[u, xy])=sinh u

(Subscript[u, xy])=sinh u,   (Subscript[u, n+1,x])+(Subscript[u, n,x])=2(Subscript[a, n])sinh (((Subscript[u, n+1])-(Subscript[u, n]))/2),   (Subscript[u, n+1,y])-(Subscript[u, n,y])=(2/(Subscript[a, n]))sinh (((Subscript[u, n+1])+(Subscript[u, n]))/2)

Преобразование Бэклунда:

u[n_]:=(Subscript[U, n])[x,y]
eqx:=D[u[n+1]+u[n],x]-2a[n]Sinh[((u[n+1]-u[n])/2)]
eqy:=D[u[n+1]-u[n],y]-(2/(a[n]))Sinh[((u[n+1]+u[n])/2)]
Simplify[((D[eqx,y]-D[eqy,x])/2)/.Solve[{eqx,eqy}==0,{D[u[n+1],x],D[u[n+1],y]}][[1]]]
Simplify[((D[eqx,y]+D[eqy,x])/2)/.Solve[{eqx,eqy}==0,{D[u[n],x],D[u[n],y]}][[1]]]

Рационализирующая подстановка:

u[n_]:=2Log[(Subscript[q, n])[x,y]]
Simplify[((D[eqx,y]-D[eqy,x])/2)/.Solve[{eqx,eqy}==0,
{D[(Subscript[q, n+1])[x,y],x],D[(Subscript[q, n+1])[x,y],y]}][[1]]];
Collect[%/Coefficient[%,D[(Subscript[q, n])[x,y],x,y]],Derivative[__][(Subscript[q, n])][x,y],Factor]


Simplify[((D[eqx,y]+D[eqy,x])/2)/.Solve[{eqx,eqy}==0,
{D[(Subscript[q, n])[x,y],x],D[(Subscript[q, n])[x,y],y]}][[1]]];
Collect[%/Coefficient[%,D[(Subscript[q, n+1])[x,y],x,y]],Derivative[__][(Subscript[q, n+1])][x,y],Factor]

Одевающая цепочка в рациональной форме:

qeqx=Collect[TrigExpand[eqx],Derivative[__][(Subscript[q, _])][x,y],Factor]
qeqy=Collect[TrigExpand[eqy],Derivative[__][(Subscript[q, _])][x,y],Factor]

Вводим второй индекс:

neqx=qeqx/.(Subscript[q, n_]):>(Subscript[q, m,n])
meqx=qeqx/.n->m/.(Subscript[q, m_]):>(Subscript[q, m,n])

neqy=qeqy/.(Subscript[q, n_]):>(Subscript[q, m,n])
meqy=qeqy/.n->m/.(Subscript[q, m_]):>(Subscript[q, m,n])

Комбинируем уравнения, чтобы уничтожить производные, это даёт формулу суперпозиции. Для краткости убираем x,y. Формула суперпозиции факторизуется. Знаменатель отбрасываем. В числителе один множитель не зависит от параметров и можно проверить, что если приравнять его 0, то это уравнение не будет совместно с дифференцированиями по x и по y. Поэтому этот множитель можно отбросить. А второй множитель даёт уравнение, совместное с дифференцированиями – это и есть формула суперпозиции.  В результате  получается уравнение, линейное по каждой из переменной (Subscript[q, m,n]),(Subscript[q, m+1,n]),(Subscript[q, m,n+1]),(Subscript[q, m+1,n+1]).

(neqx/.m->m+1)-(meqx/.n->n+1)-meqx+neqx

Factor[%/.(Subscript[q, m__])[x,y]:>(Subscript[q, m])]

F1=Numerator[%][[1]]
F2=Numerator[%%][[2]]

Проверим совместность, дифференцируя в силу цепочек. Для этого сначала выразим производные:

{neqx,neqx/.m->m+1,meqx}==0;
solx=Solve[%,{D[(Subscript[q, m,n+1])[x,y],x],D[(Subscript[q, m+1,n])[x,y],x],D[(Subscript[q, m+1,n+1])[x,y],x]}][[1]]

{neqy,neqy/.m->m+1,meqy}==0;
soly=Solve[%,{D[(Subscript[q, m,n+1])[x,y],y],D[(Subscript[q, m+1,n])[x,y],y],D[(Subscript[q, m+1,n+1])[x,y],y]}][[1]]

Теперь продифференцируем первый множитель. Нуля не получается

f1=F1/.(Subscript[q, m__]):>(Subscript[q, m])[x,y]
Factor[D[f1,x]/.solx/.Solve[f1==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

Factor[D[f1,y]/.soly/.Solve[f1==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

А со вторым множителем – все в порядке. Он дает уравнение совместное с цепочками.

f2=F2/.(Subscript[q, m__]):>(Subscript[q, m])[x,y]
Factor[D[f2,x]/.solx/.Solve[f2==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]
Factor[D[f2,y]/.soly/.Solve[f2==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

(Subscript[u, xy])=sin u

(Subscript[u, xy])=sin u,   (Subscript[u, n+1,x])+(Subscript[u, n,x])=2(Subscript[a, n])sin (((Subscript[u, n+1])-(Subscript[u, n]))/2),   (Subscript[u, n+1,y])-(Subscript[u, n,y])=(2/(Subscript[a, n]))sin (((Subscript[u, n+1])+(Subscript[u, n]))/2)

Преобразование Бэклунда:

u[n_]:=(Subscript[U, n])[x,y]
eqx:=D[u[n+1]+u[n],x]-2a[n]Sin[((u[n+1]-u[n])/2)]
eqy:=D[u[n+1]-u[n],y]-(2/(a[n]))Sin[((u[n+1]+u[n])/2)]
Simplify[((D[eqx,y]-D[eqy,x])/2)/.Solve[{eqx,eqy}==0,{D[u[n+1],x],D[u[n+1],y]}][[1]]]
Simplify[((D[eqx,y]+D[eqy,x])/2)/.Solve[{eqx,eqy}==0,{D[u[n],x],D[u[n],y]}][[1]]]

Рационализирующая подстановка:

u[n_]:=4ArcTan[(Subscript[q, n])[x,y]]
Simplify[((D[eqx,y]-D[eqy,x])/2)/.Solve[{eqx,eqy}==0,
{D[(Subscript[q, n+1])[x,y],x],D[(Subscript[q, n+1])[x,y],y]}][[1]]];
Collect[%/Coefficient[%,D[(Subscript[q, n])[x,y],x,y]],Derivative[__][(Subscript[q, n])][x,y],Factor]


Simplify[((D[eqx,y]+D[eqy,x])/2)/.Solve[{eqx,eqy}==0,
{D[(Subscript[q, n])[x,y],x],D[(Subscript[q, n])[x,y],y]}][[1]]];
Collect[%/Coefficient[%,D[(Subscript[q, n+1])[x,y],x,y]],Derivative[__][(Subscript[q, n+1])][x,y],Factor]

Одевающая цепочка в рациональной форме:

qeqx=Collect[TrigExpand[eqx],Derivative[__][(Subscript[q, _])][x,y],Factor]
qeqy=Collect[TrigExpand[eqy],Derivative[__][(Subscript[q, _])][x,y],Factor]

Вводим второй индекс:

neqx=qeqx/.(Subscript[q, n_]):>(Subscript[q, m,n])
meqx=qeqx/.n->m/.(Subscript[q, m_]):>(Subscript[q, m,n])

neqy=qeqy/.(Subscript[q, n_]):>(Subscript[q, m,n])
meqy=qeqy/.n->m/.(Subscript[q, m_]):>(Subscript[q, m,n])

Комбинируем уравнения, чтобы уничтожить производные, это даёт формулу суперпозиции. Для краткости убираем x,y. Формула суперпозиции факторизуется. Знаменатель отбрасываем. В числителе один множитель не зависит от параметров и можно проверить, что если приравнять его 0, то это уравнение не будет совместно с дифференцированиями по x и по y. Поэтому этот множитель можно отбросить. А второй множитель даёт уравнение, совместное с дифференцированиями – это и есть формула суперпозиции.  В результате  получается уравнение, линейное по каждой из переменной (Subscript[q, m,n]),(Subscript[q, m+1,n]),(Subscript[q, m,n+1]),(Subscript[q, m+1,n+1]).

(neqx/.m->m+1)-(meqx/.n->n+1)-meqx+neqx

Factor[%/4/.(Subscript[q, m__])[x,y]:>(Subscript[q, m])]

F1=Numerator[%][[2]]
F2=Numerator[%%][[1]]

Проверим совместность, дифференцируя в силу цепочек. Для этого сначала выразим производные:

{neqx,neqx/.m->m+1,meqx}==0;
solx=Solve[%,{D[(Subscript[q, m,n+1])[x,y],x],D[(Subscript[q, m+1,n])[x,y],x],D[(Subscript[q, m+1,n+1])[x,y],x]}][[1]]

{neqy,neqy/.m->m+1,meqy}==0;
soly=Solve[%,{D[(Subscript[q, m,n+1])[x,y],y],D[(Subscript[q, m+1,n])[x,y],y],D[(Subscript[q, m+1,n+1])[x,y],y]}][[1]]

Теперь продифференцируем первый множитель. Нуля не получается

f1=F1/.(Subscript[q, m__]):>(Subscript[q, m])[x,y]
Factor[D[f1,x]/.solx/.Solve[f1==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

Factor[D[f1,y]/.soly/.Solve[f1==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

А со вторым множителем – все в порядке. Он дает уравнение совместное с цепочками.

f2=F2/.(Subscript[q, m__]):>(Subscript[q, m])[x,y]
Factor[D[f2,x]/.solx/.Solve[f2==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]
Factor[D[f2,y]/.soly/.Solve[f2==0,(Subscript[q, m+1,n+1])[x,y]][[1]]]

Collect[-F2,{(Subscript[q, m,n]),(Subscript[q, m+1,n+1])},Factor]